home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / autose1g / frmcompr.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-24  |  14.7 KB  |  464 lines
  1. VERSION 5.00
  2. Object = "{D2D9B7C1-7650-11D1-9481-00A0247B7657}#1.0#0"; "ZLIBOCX2.DLL"
  3. Begin VB.Form frmCompress 
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H00000000&
  6.    BorderStyle     =   0  'None
  7.    ClientHeight    =   6900
  8.    ClientLeft      =   930
  9.    ClientTop       =   525
  10.    ClientWidth     =   9495
  11.    ControlBox      =   0   'False
  12.    ForeColor       =   &H00000000&
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    PaletteMode     =   1  'UseZOrder
  17.    ScaleHeight     =   6900
  18.    ScaleWidth      =   9495
  19.    ShowInTaskbar   =   0   'False
  20.    Begin ZLIBOCX2LibCtl.zlibIF zlibZipper 
  21.       Height          =   285
  22.       Left            =   1215
  23.       OleObjectBlob   =   "frmCompress.frx":0000
  24.       TabIndex        =   12
  25.       Top             =   5085
  26.       Visible         =   0   'False
  27.       Width           =   1680
  28.    End
  29.    Begin VB.DirListBox Dir1 
  30.       BackColor       =   &H00000000&
  31.       BeginProperty Font 
  32.          Name            =   "MS Sans Serif"
  33.          Size            =   8.25
  34.          Charset         =   0
  35.          Weight          =   700
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       ForeColor       =   &H0000FF00&
  41.       Height          =   1890
  42.       Left            =   4035
  43.       TabIndex        =   8
  44.       Top             =   2130
  45.       Width           =   2790
  46.    End
  47.    Begin VB.DriveListBox Drive1 
  48.       BackColor       =   &H00000000&
  49.       BeginProperty Font 
  50.          Name            =   "MS Sans Serif"
  51.          Size            =   8.25
  52.          Charset         =   0
  53.          Weight          =   700
  54.          Underline       =   0   'False
  55.          Italic          =   0   'False
  56.          Strikethrough   =   0   'False
  57.       EndProperty
  58.       ForeColor       =   &H0000FF00&
  59.       Height          =   315
  60.       Left            =   4050
  61.       TabIndex        =   7
  62.       Top             =   4140
  63.       Width           =   2790
  64.    End
  65.    Begin VB.Timer tmrExit 
  66.       Enabled         =   0   'False
  67.       Interval        =   3000
  68.       Left            =   360
  69.       Top             =   255
  70.    End
  71.    Begin VB.CommandButton cmdCompress 
  72.       Caption         =   "&OK"
  73.       Default         =   -1  'True
  74.       Height          =   330
  75.       Left            =   3915
  76.       TabIndex        =   5
  77.       Top             =   4950
  78.       Width           =   1200
  79.    End
  80.    Begin VB.OptionButton optGame 
  81.       BackColor       =   &H00000000&
  82.       Caption         =   "Game 5"
  83.       BeginProperty Font 
  84.          Name            =   "MS Sans Serif"
  85.          Size            =   8.25
  86.          Charset         =   0
  87.          Weight          =   700
  88.          Underline       =   0   'False
  89.          Italic          =   0   'False
  90.          Strikethrough   =   0   'False
  91.       EndProperty
  92.       ForeColor       =   &H0000FF00&
  93.       Height          =   330
  94.       Index           =   4
  95.       Left            =   2325
  96.       TabIndex        =   4
  97.       Top             =   3810
  98.       Width           =   1125
  99.    End
  100.    Begin VB.OptionButton optGame 
  101.       BackColor       =   &H00000000&
  102.       Caption         =   "Game 4"
  103.       BeginProperty Font 
  104.          Name            =   "MS Sans Serif"
  105.          Size            =   8.25
  106.          Charset         =   0
  107.          Weight          =   700
  108.          Underline       =   0   'False
  109.          Italic          =   0   'False
  110.          Strikethrough   =   0   'False
  111.       EndProperty
  112.       ForeColor       =   &H0000FF00&
  113.       Height          =   330
  114.       Index           =   3
  115.       Left            =   2325
  116.       TabIndex        =   3
  117.       Top             =   3450
  118.       Width           =   1125
  119.    End
  120.    Begin VB.OptionButton optGame 
  121.       BackColor       =   &H00000000&
  122.       Caption         =   "Game 3"
  123.       BeginProperty Font 
  124.          Name            =   "MS Sans Serif"
  125.          Size            =   8.25
  126.          Charset         =   0
  127.          Weight          =   700
  128.          Underline       =   0   'False
  129.          Italic          =   0   'False
  130.          Strikethrough   =   0   'False
  131.       EndProperty
  132.       ForeColor       =   &H0000FF00&
  133.       Height          =   330
  134.       Index           =   2
  135.       Left            =   2325
  136.       TabIndex        =   2
  137.       Top             =   3090
  138.       Width           =   1125
  139.    End
  140.    Begin VB.OptionButton optGame 
  141.       BackColor       =   &H00000000&
  142.       Caption         =   "Game 2"
  143.       BeginProperty Font 
  144.          Name            =   "MS Sans Serif"
  145.          Size            =   8.25
  146.          Charset         =   0
  147.          Weight          =   700
  148.          Underline       =   0   'False
  149.          Italic          =   0   'False
  150.          Strikethrough   =   0   'False
  151.       EndProperty
  152.       ForeColor       =   &H0000FF00&
  153.       Height          =   330
  154.       Index           =   1
  155.       Left            =   2325
  156.       TabIndex        =   1
  157.       Top             =   2730
  158.       Width           =   1125
  159.    End
  160.    Begin VB.OptionButton optGame 
  161.       BackColor       =   &H00000000&
  162.       Caption         =   "Game 1"
  163.       BeginProperty Font 
  164.          Name            =   "MS Sans Serif"
  165.          Size            =   8.25
  166.          Charset         =   0
  167.          Weight          =   700
  168.          Underline       =   0   'False
  169.          Italic          =   0   'False
  170.          Strikethrough   =   0   'False
  171.       EndProperty
  172.       ForeColor       =   &H0000FF00&
  173.       Height          =   330
  174.       Index           =   0
  175.       Left            =   2325
  176.       TabIndex        =   0
  177.       Top             =   2340
  178.       Width           =   1125
  179.    End
  180.    Begin VB.Label lblQuitGame 
  181.       Appearance      =   0  'Flat
  182.       BackColor       =   &H80000005&
  183.       BackStyle       =   0  'Transparent
  184.       Caption         =   "Quit"
  185.       Enabled         =   0   'False
  186.       BeginProperty Font 
  187.          Name            =   "MS Sans Serif"
  188.          Size            =   13.5
  189.          Charset         =   0
  190.          Weight          =   400
  191.          Underline       =   0   'False
  192.          Italic          =   0   'False
  193.          Strikethrough   =   0   'False
  194.       EndProperty
  195.       ForeColor       =   &H000000FF&
  196.       Height          =   420
  197.       Left            =   4185
  198.       TabIndex        =   11
  199.       Top             =   5895
  200.       Visible         =   0   'False
  201.       Width           =   690
  202.    End
  203.    Begin VB.Label lblContinue 
  204.       Appearance      =   0  'Flat
  205.       BackColor       =   &H80000005&
  206.       BackStyle       =   0  'Transparent
  207.       Caption         =   "Continue this game"
  208.       Enabled         =   0   'False
  209.       BeginProperty Font 
  210.          Name            =   "MS Sans Serif"
  211.          Size            =   13.5
  212.          Charset         =   0
  213.          Weight          =   400
  214.          Underline       =   0   'False
  215.          Italic          =   0   'False
  216.          Strikethrough   =   0   'False
  217.       EndProperty
  218.       ForeColor       =   &H000000FF&
  219.       Height          =   465
  220.       Left            =   3375
  221.       TabIndex        =   10
  222.       Top             =   5310
  223.       Visible         =   0   'False
  224.       Width           =   3165
  225.    End
  226.    Begin VB.Label lblMessage 
  227.       BackStyle       =   0  'Transparent
  228.       BeginProperty Font 
  229.          Name            =   "MS Sans Serif"
  230.          Size            =   13.5
  231.          Charset         =   0
  232.          Weight          =   400
  233.          Underline       =   0   'False
  234.          Italic          =   0   'False
  235.          Strikethrough   =   0   'False
  236.       EndProperty
  237.       ForeColor       =   &H0000FF00&
  238.       Height          =   420
  239.       Left            =   2790
  240.       TabIndex        =   9
  241.       Top             =   4635
  242.       Width           =   4020
  243.    End
  244.    Begin VB.Label lblTitle 
  245.       BackStyle       =   0  'Transparent
  246.       Caption         =   "Save Game"
  247.       BeginProperty Font 
  248.          Name            =   "MS Sans Serif"
  249.          Size            =   13.5
  250.          Charset         =   0
  251.          Weight          =   700
  252.          Underline       =   0   'False
  253.          Italic          =   0   'False
  254.          Strikethrough   =   0   'False
  255.       EndProperty
  256.       ForeColor       =   &H0000FF00&
  257.       Height          =   345
  258.       Left            =   3555
  259.       TabIndex        =   6
  260.       Top             =   1350
  261.       Width           =   1680
  262.    End
  263. Attribute VB_Name = "frmCompress"
  264. Attribute VB_GlobalNameSpace = False
  265. Attribute VB_Creatable = False
  266. Attribute VB_PredeclaredId = True
  267. Attribute VB_Exposed = False
  268. Option Explicit
  269. Public frmCompressStarsDrawn As Boolean  'prevent starfield being drawn over and over
  270.                                         'reset with lblContinue, so next turn the stars are drawn
  271.                                         
  272. Private Sub cmdCompress_Click()
  273. 'use the zlib compression OCX to compress the text file for emailing
  274. Dim X As Integer
  275. Dim TempTurnNumber As String
  276. Dim Letter As String
  277. Dim Path As String
  278. 'play button sound
  279. PlaySoundEffect "Button5"
  280. Path = Dir1.Path
  281. 'make sure path ends with backslash
  282. If Right(Path, 1) <> "\" Then
  283.     Path = Path + "\"
  284. End If
  285. 'set tags for player 1 or 2
  286. If Current = 0 Then         'player 1 is saving a game
  287.     Letter = "a"
  288.     Letter = "b"            'player 2 is saving a game
  289. End If
  290. If Current = 1 Then
  291.     TempTurnNumber = Trim(Str(TurnNumber - 1))
  292.     TempTurnNumber = Trim(Str(TurnNumber))
  293. End If
  294. For X = 0 To 4
  295.     If optGame(X).Value = True Then
  296.         GameNumber = X + 1
  297.         'this is the game being saved
  298.         'set the gamenumber variable again to let user continue playing this game
  299.         'ZlibTool1.InputFile = App.Path + "\gameinfo.txt"
  300.         zlibZipper.InputFileName = App.Path + "\gameinfo.txt"
  301.         
  302.         'ZlibTool1.OutputFile = Path + "g" + Trim(Str(x + 1)) + "-" + TempTurnNumber + Letter + ".zlb"
  303.         zlibZipper.OutputFileName = Path + "g" + Trim(Str(X + 1)) + "-" + TempTurnNumber + Letter + ".zlb"
  304.         
  305.         GameName = "g" + Trim(Str(X + 1)) + "-" + TempTurnNumber + Letter + ".zlb"
  306.         
  307.         'compress the file, with save info built into the file name
  308.         'ZlibTool1.Compress
  309.         zlibZipper.Compress
  310.         
  311.     End If
  312. Next X
  313. lblMessage.Caption = "Game Saved As:" + GameName
  314. tmrExit.Enabled = True
  315. cmdCompress.Visible = False
  316. cmdCompress.Enabled = False
  317. End Sub
  318. Private Sub cmdExit_Click()
  319. End Sub
  320. Private Sub cmdContinue_Click()
  321. 'continue with same game
  322. frmCover.ReadBigFile
  323. 'change from one player to the other
  324. If Current = 0 Then
  325.     Current = 1
  326.     Other = 0
  327. ElseIf Current = 1 Then
  328.     Current = 0
  329.     Other = 1
  330. End If
  331. If Player(Current).Name = "" Then
  332.     frmPlayer2Setup.Show Modal
  333. End If
  334. PlaySoundEffect "Ambient1"
  335. Load frmGameScreen
  336. Unload Me
  337. frmGameScreen.Show
  338. End Sub
  339. Private Sub Drive1_Change()
  340. 'standard file navigation - update drive and directories as needed
  341. On Error GoTo DriveError
  342. Dir1.Path = Drive1.Drive
  343. Exit Sub
  344. DriveError:
  345. PlaySoundEffect "Quiet"
  346. MsgBox "Please Choose Another Drive", vbExclamation, "Drive Selection Error"
  347. Drive1.Drive = Dir1.Path
  348. Exit Sub
  349. End Sub
  350. Private Sub Form_Activate()
  351. If frmCompressStarsDrawn = False Then
  352. 'draw stars on the screen
  353.     Dim a, X, Y
  354.     For a = 1 To 600
  355.         X = Int(Rnd * Me.ScaleWidth)
  356.         Y = Int(Rnd * Me.ScaleHeight)
  357.         Me.PSet (X, Y), vbWhite
  358.     Next a
  359.     'draw darker stars
  360.     Dim grey
  361.     grey = &H808080
  362.     For a = 1 To 800
  363.        X = Int(Rnd * Me.ScaleWidth)
  364.        Y = Int(Rnd * Me.ScaleHeight)
  365.        Me.PSet (X, Y), grey
  366.     Next a
  367.        
  368.     'draw some blue stars
  369.     Dim blue
  370.     blue = &H800000
  371.     For a = 1 To 600
  372.        X = Int(Rnd * Me.ScaleWidth)
  373.        Y = Int(Rnd * Me.ScaleHeight)
  374.        Me.PSet (X, Y), blue
  375.     Next a
  376.     frmCompressStarsDrawn = True   'prevent stars from being drawn again and again and again...
  377. End If
  378. End Sub
  379. Private Sub Form_Load()
  380. 'set to same windowstate as frmgamescreen, which may be windowed
  381. Me.WindowState = frmGameScreen.WindowState   'vbMaximized
  382. Me.Top = frmGameScreen.Top
  383. Me.Left = frmGameScreen.Left
  384. Unload frmGameScreen
  385. 'set up explorer-type window
  386. Drive1.Drive = App.Path
  387. Dir1.Path = App.Path
  388. '*** use GameNumber to activate the proper option box
  389. 'ie., if player loaded up game 4, this will default to save game 4
  390. optGame(GameNumber - 1).Value = True
  391. End Sub
  392. Private Sub Label2_Click()
  393. End Sub
  394. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  395. lblContinue.ForeColor = vbRed
  396. lblQuitGame.ForeColor = vbRed
  397. End Sub
  398. Private Sub lblContinue_Click()
  399. 'continue with same game
  400. frmCover.ReadBigFile
  401. 'change from one player to the other
  402. If Current = 0 Then
  403.     Current = 1
  404.     Other = 0
  405. ElseIf Current = 1 Then
  406.     Current = 0
  407.     Other = 1
  408. End If
  409. If Player(Current).Name = "" Then
  410.     frmPlayer2Setup.Show Modal
  411. End If
  412. PlaySoundEffect "Ambient1"
  413. Load frmGameScreen
  414. 'set game screen to same windowstate - ie. windowed
  415. frmGameScreen.WindowState = Me.WindowState
  416. 'reset variable to allow stars to be drawn next time
  417. frmCompressStarsDrawn = False
  418. Unload Me
  419. frmGameScreen.Show
  420. End Sub
  421. Private Sub lblContinue_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  422. 'change colour as mouse moves over label
  423. lblContinue.ForeColor = vbBlue
  424. lblQuitGame.ForeColor = vbRed
  425. End Sub
  426. Private Sub lblQuitGame_Click()
  427. If TurnNumber = 1 Then
  428.         'for some as-yet unknown reason (at least to me),
  429.         'the program will not shut all the way down on turn 1
  430.         'unless I use End - I know it makes no sense, but...
  431.         
  432.         End
  433.     Else
  434.        '***Alternative to using End:
  435.         Dim F As Long
  436.         'fade form into taskbar
  437.         Me.WindowState = 1
  438.         'count forms opened
  439.         For F = Forms.Count - 1 To 0 Step -1
  440.            Unload Forms(F)
  441.         Next F
  442.         'close any open files
  443.         If (Forms.Count = 0) Then Close
  444.         'set all open forms to Nothing
  445.         Set frmGameScreen = Nothing
  446.     End If
  447. 'delete the gaminfo.txt file
  448. On Error Resume Next
  449. Kill (App.Path + "\gameinfo.txt")
  450. On Error GoTo 0
  451. End Sub
  452. Private Sub lblQuitGame_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  453. 'change colour as mouse moves over label
  454. lblQuitGame.ForeColor = vbBlue
  455. lblContinue.ForeColor = vbRed
  456. End Sub
  457. Private Sub tmrExit_Timer()
  458. 'show labels to let user continue game or quit
  459. lblContinue.Enabled = True
  460. lblContinue.Visible = True
  461. lblQuitGame.Enabled = True
  462. lblQuitGame.Visible = True
  463. End Sub
  464.